home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / FGL304F.ZIP;1 / EXFOR.ARJ / FGDOC / EXAMPLES / FORTRAN / 17-02.FOR < prev    next >
Encoding:
Text File  |  1994-01-24  |  1.6 KB  |  73 lines
  1. $INCLUDE: 'C:\FG\INTRFACE.FOR'
  2.  
  3.       PROGRAM MAIN
  4.  
  5.       INTEGER*2 RECTANGLES
  6.       PARAMETER (RECTANGLES=200)
  7.  
  8.       INTEGER*2 I
  9.       INTEGER*2 MINX, MAXX, MINY, MAXY
  10.       INTEGER*2 OLD_MODE
  11.       INTEGER*2 XRES, YRES
  12.       INTEGER*2 RANDOM
  13.       INTEGER*2 FG_AUTOMODE, FG_EGACHECK, FG_GETMODE
  14.       INTEGER*2 FG_GETMAXX, FG_GETMAXY
  15.  
  16.       IF (FG_EGACHECK() .EQ. 0) THEN
  17.          STOP 'This program requires EGA or VGA.'
  18.       END IF
  19.  
  20.       OLD_MODE = FG_GETMODE()
  21.       CALL FG_SETMODE(FG_AUTOMODE())
  22.       CALL FG_SETFUNC(3)
  23.  
  24.       XRES = FG_GETMAXX()
  25.       YRES = FG_GETMAXY()
  26.  
  27.       DO 10 I = 1,RECTANGLES
  28.          MINX = RANDOM(0,XRES)
  29.          MAXX = RANDOM(0,XRES)
  30.          MINY = RANDOM(0,YRES)
  31.          MAXY = RANDOM(0,YRES)
  32.          IF (MINX .GT. MAXX) THEN
  33.             CALL SWAP(MINX,MAXX)
  34.          END IF
  35.          IF (MINY .GT. MAXY) THEN
  36.             CALL SWAP(MINY,MAXY)
  37.          END IF
  38.          CALL FG_SETCOLOR(RANDOM(0,15))
  39.          CALL FG_RECT(MINX,MAXX,MINY,MAXY)
  40. 10    CONTINUE
  41.  
  42.       CALL FG_SETMODE(OLD_MODE)
  43.       CALL FG_RESET
  44.  
  45.       STOP ' '
  46.       END
  47.  
  48.       INTEGER*2 FUNCTION RANDOM(MIN,MAX)
  49.  
  50.       INTEGER*2 MIN, MAX
  51.       INTEGER*2 SEED, TEMP
  52.  
  53.       DATA SEED /12345/
  54.  
  55.       TEMP = IEOR(SEED,ISHFT(SEED,-7))
  56.       SEED = IAND(IEOR(ISHFT(TEMP,8),TEMP),#7FFF)
  57.       RANDOM = MOD(SEED,MAX-MIN+1) + MIN
  58.  
  59.       RETURN
  60.       END
  61.  
  62.       SUBROUTINE SWAP(VAR1,VAR2)
  63.       INTEGER*2 VAR1, VAR2
  64.       INTEGER*2 TEMP
  65.  
  66.       TEMP = VAR1
  67.       VAR1 = VAR2
  68.       VAR2 = TEMP
  69.  
  70.       RETURN
  71.       END
  72.  
  73.